home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-guardian.el.z / efs-guardian.el
Encoding:
Text File  |  1998-05-21  |  7.8 KB  |  242 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-guardian.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.7 $
  7. ;; RCS:          
  8. ;; Description:  Guardian support for efs
  9. ;; Author:       Sandy Rutherford <sandy@math.ubc.ca>
  10. ;; Created:      Sat Jul 10 12:26:12 1993 by sandy on ibm550
  11. ;; Language:     Emacs-Lisp
  12. ;;
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14.  
  15. ;;; This file is part of efs. See efs.el for copyright
  16. ;;; (it's copylefted) and warrranty (there isn't one) information.
  17.  
  18. ;;; Acknowledgements:
  19. ;;; Adrian Philips and David Karr for answering questions
  20. ;;; and debugging. Thanks.
  21.  
  22. (defconst efs-guardian-version
  23.   (concat (substring "$efs release: 1.15 $" 14 -2)
  24.       "/"
  25.       (substring "#Revision: 1.7 $" 11 -2)))
  26.  
  27. (provide 'efs-guardian)
  28. (require 'efs)
  29.  
  30. ;;;; ------------------------------------------------------------
  31. ;;;; Support for Tandem's GUARDIAN operating system.
  32. ;;;; ------------------------------------------------------------
  33.  
  34. ;;;  Supposed to work for (Version 2.7 TANDEM 01SEP92).
  35.  
  36. ;;;  File name syntax:
  37. ;;;
  38. ;;;  File names are of the form volume.subvolume.file where
  39. ;;;  volume is $[alphanumeric characters]{1 to 7}
  40. ;;;  subvolume is <alpha character>[<alphanumeric character>]{0 to 7}
  41. ;;;  and file is the same as subvolume.
  42.  
  43. (defconst efs-guardian-date-regexp
  44.   (concat
  45.    " [ 1-3][0-9]-\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|"
  46.    "Sep\\|Oct\\|Nov\\|Dec\\)-[0-9][0-9] "))
  47.  
  48. ;;; entry points -- 2 of 'em.
  49.  
  50. (efs-defun efs-fix-path guardian (path &optional reverse)
  51.   ;; Convert PATH from unix-ish to guardian.
  52.   ;; If REVERSE is non-nil do just that.
  53.   (efs-save-match-data
  54.     (let ((case-fold-search t))
  55.       (if reverse
  56.       (if (string-match
  57.            (concat
  58.         "^\\(\\\\[A-Z0-9]+\\.\\)?"
  59.         "\\(\\$[A-Z0-9]+\\)\\.\\([A-Z0-9]+\\)\\(\\.[A-Z0-9]+\\)?$")
  60.            path)
  61.           (concat
  62.            "/"
  63.            (substring path (match-beginning 2) (match-end 2))
  64.            "/"
  65.            (substring path (match-beginning 3) (match-end 3))
  66.            "/"
  67.            (and (match-beginning 4)
  68.             (substring path (1+ (match-beginning 4)))))
  69.         (error "path %s is invalid for the GUARDIAN operating system"
  70.            path))
  71.     (if (string-match
  72.          "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$" path)
  73.         (apply 'concat
  74.            (substring path 1 (match-end 1))
  75.            "."
  76.            (substring path (match-beginning 2) (match-end 2))
  77.            (and (match-beginning 3)
  78.             (/= (- (match-end 3) (match-beginning 3)) 1)
  79.             (list "."
  80.                   (substring path (1+ (match-beginning 3))))))
  81.       (error "path %s is invalid for the guardian operating system"
  82.          path))))))
  83.   
  84. (efs-defun efs-fix-dir-path guardian (dir-path)
  85.   ;; Convert DIR-PATH from unix-ish to guardian fir a DIR listing.
  86.   (efs-save-match-data
  87.     (let ((case-fold-search t))
  88.       (cond
  89.        ((string-equal "/" dir-path)
  90.     (error "Can't grok guardian disk volumes."))
  91.        ((string-match "^/\\$[A-Z0-9]+/?$" dir-path)
  92.     (error "Can't grok guardian subvolumes."))
  93.        ((string-match "^/\\(\\$[A-Z0-9]+\\)/\\([A-Z0-9]+\\)\\(/[A-Z0-9]*\\)?$"
  94.               dir-path)
  95.     (apply 'concat
  96.            (substring dir-path 1 (match-end 1))
  97.            "."
  98.            (substring dir-path (match-beginning 2) (match-end 2))
  99.            (and (match-beginning 3)
  100.             (/= (- (match-end 3) (match-beginning 3)) 1)
  101.             (list "."
  102.               (substring dir-path (1+ (match-beginning 3)))))))
  103.        (t
  104.     (error "path %s is invalid for the guardian operating system"))))))
  105.  
  106. (efs-defun efs-parse-listing guardian
  107.   (host user dir path &optional switches)
  108.   ;; Parses a GUARDIAN DIRectory listing.
  109.   ;; HOST = remote host name
  110.   ;; USER = remote user name
  111.   ;; DIR = remote directory as a remote full path
  112.   ;; PATH = directory as an efs full path
  113.   ;; SWITCHES are never used here, but they
  114.   ;; must be specified in the argument list for compatibility
  115.   ;; with the unix version of this function.
  116.   (efs-save-match-data
  117.     (goto-char (point-min))
  118.     (if (re-search-forward efs-guardian-date-regexp nil t)
  119.     (let ((tbl (efs-make-hashtable))
  120.           file size)
  121.       (while
  122.           (progn
  123.         (beginning-of-line)
  124.         (setq file (buffer-substring (point)
  125.                          (progn
  126.                            (skip-chars-forward "A-Z0-9")
  127.                            (point))))
  128.         (skip-chars-forward " ")
  129.         (skip-chars-forward "^ ")
  130.         (skip-chars-forward " ")
  131.         (setq size (string-to-int (buffer-substring
  132.                        (point)
  133.                        (progn
  134.                          (skip-chars-forward "0-9")))))
  135.         (efs-put-hash-entry file (list nil size) tbl)
  136.         (forward-line 1)
  137.         (re-search-forward efs-guardian-date-regexp nil t)))
  138.       (efs-put-hash-entry "." '(t) tbl)
  139.       (efs-put-hash-entry ".." '(t) tbl)
  140.       tbl))))
  141.  
  142. (efs-defun efs-allow-child-lookup guardian (host user dir file)
  143.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  144.   ;; according to its file-name syntax, and therefore a child listing should
  145.   ;; be attempted.
  146.   (efs-save-match-data
  147.     (let ((case-fold-search t))
  148.       (string-match "^/\\$[A-Z0-9]+/$" dir))))
  149.  
  150. (efs-defun efs-internal-file-directory-p guardian (file)
  151.   ;; Directories pop into existence simply by putting files in them.
  152.   (efs-save-match-data
  153.     (let ((case-fold-search t))
  154.       (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
  155.       t
  156.     (efs-internal-file-directory-p nil file)))))
  157.  
  158. (efs-defun efs-internal-file-exists-p guardian (file)
  159.   ;; Directories pop into existence simply by putting files in them.
  160.   (efs-save-match-data
  161.     (let ((case-fold-search t))
  162.       (if (string-match "^/\\$[A-Z0-9]+\\(/[A-Z0-9]+\\)?/?$" file)
  163.       t
  164.     (efs-internal-file-exists-p nil file)))))
  165.  
  166. ;;; Tree Dired support
  167.  
  168. (defconst efs-dired-guardian-re-exe nil)
  169.  
  170. (or (assq 'guardian efs-dired-re-exe-alist)
  171.     (setq efs-dired-re-exe-alist
  172.       (cons (cons 'guardian  efs-dired-guardian-re-exe)
  173.         efs-dired-re-exe-alist)))
  174.  
  175. (defconst efs-dired-guardian-re-dir nil)
  176.  
  177. (or (assq 'guardian efs-dired-re-dir-alist)
  178.     (setq efs-dired-re-dir-alist
  179.       (cons (cons 'guardian  efs-dired-guardian-re-dir)
  180.         efs-dired-re-dir-alist)))
  181.  
  182. (efs-defun efs-dired-manual-move-to-filename guardian
  183.   (&optional raise-error bol eol)
  184.   ;; In dired, move to first char of filename on this line.
  185.   ;; Returns position (point) or nil if no filename on this line.
  186.   ;; This is the guardian version.
  187.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  188.   (if bol
  189.       (goto-char bol)
  190.     (skip-chars-backward "^\n\r")
  191.     (setq bol (point)))
  192.   (if (save-excursion (re-search-forward efs-guardian-date-regexp eol t))
  193.       (progn
  194.     (if (looking-at ". [^ ]")
  195.         (forward-char 2))
  196.     (point))
  197.     (and raise-error (error "No file on this line"))))
  198.  
  199. (efs-defun efs-dired-manual-move-to-end-of-filename guardian
  200.   (&optional no-error bol eol)
  201.   ;; Assumes point is at beginning of filename.
  202.   ;; So, it should be called only after (dired-move-to-filename t).
  203.   ;; On failure, signals an error or returns nil.
  204.   ;; This is the guardian version.
  205.   (and selective-display
  206.        (null no-error)
  207.        (eq (char-after
  208.         (1- (or bol (save-excursion
  209.               (skip-chars-backward "^\r\n")
  210.               (point)))))
  211.        ?\r)
  212.        ;; File is hidden or omitted.
  213.        (cond
  214.     ((dired-subdir-hidden-p (dired-current-directory))
  215.      (error
  216.       (substitute-command-keys
  217.        "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  218.     ((error
  219.       (substitute-command-keys
  220.        "File line is omitted. Type \\[dired-omit-toggle] to un-omit.")))))
  221.   (if (and
  222.        (>= (following-char) ?A)
  223.        (<= (following-char) ?Z)
  224.        (progn
  225.      (skip-chars-forward "A-Z0-9")
  226.      (= (following-char) ?\ )))
  227.       (point)
  228.     (and (null no-error)
  229.      (error "No file on this line"))))
  230.  
  231. (efs-defun efs-dired-ls-trim guardian ()
  232.   (goto-char (point-min))
  233.   (let (case-fold-search)
  234.     (if (re-search-forward efs-guardian-date-regexp nil t)
  235.     (progn
  236.       (beginning-of-line)
  237.       (delete-region (point-min) (point))
  238.       (forward-line 1)
  239.       (delete-region (point) (point-max))))))
  240.  
  241. ;;; end of efs-guardian.el
  242.